perm filename PGSUB.2[MSS,LCS]1 blob sn#242182 filedate 1976-10-18 generic text, type T, neo UTF8
00100	C****  VARIOUS SUBROUTINES FOR PAGE LAYOUT PROGRAM. ****
00200	
00300		SUBROUTINE FILOUT(NAMQ,NPG)
00400		COMMON /FIN/JBAR,METR,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
00500		1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2
00600		1  /SF/KL,RT,KP,STFSZ,NAMX
00700		MTR1=-1
00800		MTR2=-1
00900		NAMQ='AAAAA'
01000	103	FORMAT(' TYPE OUTPUT FILE NAME  ',$)
01100	102	FORMAT(A5)
01200		TYPE 103
01300		ACCEPT 102,NAMX
01400		IF(NAMX.EQ.' ')NAMX=NAMQ
01500		NAMZ=NAMX
01600		NPG=1
01700		IF(LOOKF(NAMX).GE.0)GO TO 88
01800		TYPE 88,NAMX
01900		ACCEPT 102,L
02000		IF(L.EQ.'N')GO TO 103
02100	88	FORMAT(' WRITE OVER FILE ',A5,'????  '$)
02200		END
02300	
02400		SUBROUTINE METER(MTR,R)
02500		COMMON /FIN/JBAR,METR,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
02600		1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2
02700		1/IPG/IPG,JPG,BRACK,RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(-3/4) 
02800		1 /SF/KL,RT,KP,STFSZ,NAMX
02900		K=MTR/100
03000		B=MTR-K*100
03100		A=K
03200		J=LPG
03300	1	RT=RSTNUM(J)
03400	C RT (IN COMMON) TRANSFERS THE STAFF NUM. TO SUBR. STAFF
03500	C  PUT METER ON ALL STAVES FOR PAGE LAYOUT
03600		CALL STAFF(4.,18.,R,0,A,B,0,0)
03700	C  PUTS IN METER AT START OF STAFF
03800		J=J-1
03900		IF(J.GT.0)GO TO 1
04000		MTR=-1
04100		END
04200	
04300	
04400		SUBROUTINE FILEIN
04500		COMMON /FIN/JBAR,METR,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
04600		1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2
04700		1/IPG/IPG,JPG,BRACK,RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(-3/4) 
04800		1 /RSP/KNM(10),ENDLN,N,NAME,NMPG,T /KBAR/KBAR(512)
04900		COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
05000		COMMON /POSI/STFF(-3/4),JJ2,JPQ /LLL/L,LL,I,RXQ
05100		COMMON/STF/RSTFAC(-3/4),RSTJ2 /PX/KPN(1) /Q/Q(1)
05200		1 /NBAR/NBAR(36) /SIZE/SIZE
05300		EQUIVALENCE (LASTNM,KBAR(3))
05400	
05500		IF(NBAR(LC).EQ.0)CALL EXIT
05600		IF(KPX.EQ.1)GO TO 104
05700	C  SKIP THIS FIRST TIME.  IT SHUFFLES DATA FORWARD IN ARRAY.
05800		J=KPX-1
05900		JJ=KPN(KPX)-1
06000		DO 105 K=1,NPX-J
06100	105	KPN(K)=KPN(K+J)-JJ
06200		J=KPN(NPX)-JJ
06300	C  HOW MUCH TO SHIFT THE Q ARRAY
06400		DO 106 K=1,J
06500	106	Q(K)=Q(K+JJ)
06600		KPX =NPX-KPX+1
06700	C  UPDATE POINTERS FOR NEXT READIN
06800		KQ=KPN(KPX)
06900		JPX=KQ-1
07000	
07100	104	KL=1
07200		KP=1
07300		JEND=0
07400	C  FLAG FOR PAGE END - WHEN -1
07500	CC	RT=2
07600	CC	J=KK
07700	CC	HGT=HX*2.
07800	CC	LD=0
07900	CC	MTR1=-1
08000	CC	K=KK-1
08100		IF(LB.LT.NBAR(LC))GO TO 220
08200		NPX=KPX
08300		KPX=1
08400		LB=0
08500		GO TO 241
08600	220	CALL GETFIL(NMPG)
08700		CALL FASTIN(RSTFAC,22)
09700	211	CALL FASTIN(KPN(KPX),JJ2)
09800		CALL FASTIN(Q(KQ),JPQ)
09900		IF(KPX.EQ.1)GO TO 140
10000		DO 420 JP=KPX,JJ2+KPX-1
10100	420	KPN(JP)=KPN(JP)+JPX
10200		
10300	140	JPX=KQ+JPQ-3
10400	C  NUM OF WORDS TO SHIFT.
11200	41	NMPG=NMPG+2
11300	C  NMPG = NAME OF INPUT FILES
11400	CC	L=JJ2-2
11500	CC	NPX=KPX+L
11600		NPX=KPX+JJ2-2
11700	241	JBAR=NBAR(LC)
11800		DO 20 JP=KPX,NPX-1
11900		N=KPN(JP)
12000		IF(Q(N+1).NE.4)GO TO 20
12100	C  FINDS BAR LINES IN THIS PART OF DATA
12200		LB=LB+1
12300		IF(LB.NE.JBAR)GO TO 20
12400		KPX=JP+1
12500	520	IF(Q(KPN(KPX)+1).NE.18)GO TO 20
12600	C  LOOKS FOR METER BEYOND LAST BAR IN LINE
12700		IF(KPX.GE.NPX)GO TO 20
12800		KPX=KPX+1
12900		GO TO 520
13000	20	CONTINUE
13100		IF(LB.GE.JBAR)GO TO 120
13200		KPX=NPX
13300		KQ=JPX+1
13400		GO TO 220
13500	120	KQ=KPN(KPX)
13600		LB=LB-JBAR
13700		L=KPX-1
13800	C L=TOTAL ITEMS FOR THIS LINE. JBAR=TOTAL BARS, LB=HOW MANY LEFT OVER
13900		I=L
14000		IF(LB.NE.0)RETURN
14100		KPX=1
14200		KQ=1
14300		END
14400	
14500		SUBROUTINE STAVES
14600		DATA SLSP/12.0/
14610		DIMENSION BEG(500)
14700		COMMON /FIN/JBAR,METR,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
14800		1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2
14900		COMMON /SF/KL,RT,KP,STFSZ,NAMX /IPG/IPG,JPG,BRACK,
15000		1 RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(-3/4) 
15100		1 /RSP/KNM(10),ENDLN,N,NAME,NMPG,T /KBAR/KBAR(512)
15200		COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
15300		COMMON/STF/RSTFAC(-3/4),RSTJ2 /IVV/OSLUR(1)
15400		COMMON /POSI/STFF(-3/4),JJ2,JPQ /LLL/L,LL,I,RXQ
15500		1/PX/KPN(1) /Q/Q(1) /PTR/KWDS(1) /XRN/RN(1) /NBAR/NBAR(36)
15600		EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5))
15700		1,(R8,RQ(6)),(R9,RQ(7)),(BEG,RN(2001))
15710	C BEG ARRAY WILL STORE END OF LINE CARRYOVER STUFF.
15800		IF(LC.EQ.1)RA=0
15900	C RA IS LEFT POS OF Q DATA. (IT SHIFTS AS LC CHANGES.)
16000		KL=1
16100		KP=1
16200		LC=LC+1
16300	335	RX=0
16400		IF(NBAR(LC).EQ.0)JEND=-1
16500	3	JJ=KP
16600	
16700	C ******** PUTS IN STAFF ********
16800		RS=3.
16900	C  RS IS WDCNT FOR SUBR. STAFF
17000		IF(RT.NE.0)GO TO 331
17100	C NEXT FOR BOTTOM STAFF.  PUTS IN SPACER.
17200		RS=6.
17300	331	IF(IPG)GO TO 411
17400		HX=8
17500		RZ=0
17600		RX=RT
17700		DO 611 JP=1,LPG
17800		RT=RSTNUM(JP)
17900		RS=3
18000	C WD CNT IS RS, HX IS CODE(8), ARRAYS AND LPG(JPG) WERE SET UP IN MAIN.
18100		RR=0
18200		IF(JP.GT.1)GO TO 611
18300		IF(NAMX.EQ.NAMZ)GO TO 611
18400		RS=6
18500		RR=SPG
18600	C  FOR SPACER ON STAFF 0
18700	611	CALL STAFF(RS,HX,RZ,RHGT(JP),RPSZ(JP),RZ,RZ,RR)
18800		HX=LPG
18900		RS=4.
19000		RT=0
19100		CALL STAFF(2.,RS,RZ,HX,RZ,RZ,RZ,RZ)
19200		IF(BRACK.NE.0)CALL STAFF(5.,RS,RZ,HX,RZ,RZ,BRACK,RZ)
19300		RT=RX
19400		GO TO 511
19500	411	CALL STAFF(RS,8.,0,HGT,RSTJ2,0,0,SP)
19600		HGT=HGT-HX
19700	511	IF(JEND)GO TO 60
19800	C FOR PREMATURE PAGE END
19900	CP	IF(K.NE.I)GO TO 6
20000		IF(RT.EQ.0)GO TO 6
20100	60	IF(IPG.EQ.0)GO TO 6
20200		RX=RT
20300		RT=0
20400		CALL STAFF(6.,8.,0,0,0,0,1.,SP)
20500	C  PUTS IN SPACER
20600		RT=RX
20700	
20800	6	IF(JSLUR.EQ.0)GO TO 333
20900	C ***** PUT SLUR AT END OF LINE ********
21000		JSLUR=0
21100		K4=2
21200		K5=3
21300		K7=4
21400		RT=OSLUR(1)
21500	1333	CALL STAFF(5.,5.,0,OSLUR(K4),OSLUR(K5),SLSP,OSLUR(K7),0)
21600		IF(JSL2.EQ.0)GO TO 333
21700	C FOR 2ND SLUR AT END OF LINE.
21800		JSL2=0
21900		K4=6
22000		K5=7
22100		K7=8
22200		RT=OSLUR(5)
22300		GO TO 1333
22400	
22500	C  ****** NEXT FOR CLEFS ************
22600	333	IF(CLEF.EQ.-99)GO TO 33
22700	C  ONLY STAFF FOR FIRST LINE AT TOP.
22800		RX=8.*RSTJ2
22900	C  THE SPACER
23000		LA=0
23100		IF(IPG)GO TO 3011
23200		LA=LPG
23300	3111	RT=RSTNUM(LA)
23400		LL=RT
23500		CLEF=RCLEF(LL)
23600	C GETS CLEF FOR PAGE LAYOUT, RT IS STAFF# IN CALL
23700		LA=LA-1
23800	3011	CALL STAFF(3.,3.,1.5,0,CLEF,0,0,0)
23900		IF(SIG.EQ.-99)GO TO 3211
24000	C  ***** NEXT FOR KEY SIG. ********
24100		RS=4.
24200		R5=SIG
24300	332	CALL STAFF(RS,17.,10.0*RSTJ2,0,R5,CLEF,0,0)
24400	3211	IF(LA.GT.0)GO TO 3111
24500		RX=11.*RSTJ2
24600	C  RX SETS POS OF NEXT ITEM ON STAFF
24700		R7=RX
24800	
24900	C *****  NEXT FOR METER CHANGES TO APPEAR AT START OF STAFF*****
25000	33  	IF(MTR1)GO TO 31
25100		R=R7+RSTJ2*3
25200		CALL METER(MTR1,R)
25300	C  PUT METER ON ALL STAVES FOR PAGE LAYOUT
25400	C  PUTS IN METER AT START OF STAFF
25500		IF(MTR2)GO TO 5211
25600		R=7.5*RSTJ2+R7
25700		CALL METER(MTR2,R)
25800	C  PUTS COMPOSITE METER AFTER END OF STAFF
25900	5211	RX=R+RSTJ2
26000	C  RX SPACES NEXT ITEM TO RIGHT OF LINE BEGINNING.
26100	31	R4=RA
26200		LA=I
26300	231	K4=KPN(LA)
26400		R=Q(K4+1)
26500		IF(R.EQ.4)GO TO 131
26600		LA=LA-1
26700		GO TO 231
26800	131	R5=Q(K4+3)
26900		RS=0
27000		R7=RT
27100		R8=RX
27200		R9=200.
27300		LL=0
27400		L=I
27500		CALL PTMOVE(Q,KPN)
27600		RA=R5
27700		IF(LA.EQ.I)RETURN
27800	C NEXT PUTS METER JUST BEYOND END OF LINE
27900		R=202
28000		R7=Q(KPN(LA+1)+3)
28100	C  R7 HOLDS STAFF NUM. FOR THINGS BEYOND END OF LINE.
28200		DO 431 K5=LA+1,I
28300		K7=KPN(K5)
28400		K4=0
28500		IF(Q(K7+1).EQ.18)K4=Q(K7+5)*100+Q(K7+6)
28600	C  K4 STORES METER (TOP*100+BOTTOM)
28700		IF(Q(K7+3).EQ.R7)GO TO 531
28800		R7=Q(K7+3)
28900	C THIS PROBABLY WON'T ALWAYS DO THE RIGHT THING!!
29000		R=R+5
29100		IF(MTR1.GT.0.AND.K4.NE.0)MTR2=K4
29200	531	IF(K4.NE.0.AND.MTR1)MTR1=K4
29300	431	Q(K7+3)=R
29400		END
29500